library(dplyr)
library(tidyr)
library(lubridate)
library(DT)
library(plotly)
library(DescTools)This report utilizes the data collected by the FPL/IM Information systems team on COVID-19 vaccination in the Americas to evaluate the possibility of countries in the region to reach complete vaccination of 40% of their population (UN Populations for 2021) by December 31st, 2021 and 70% by June 30 2022
To provide insight and adequately assess how vaccination progresses, we analyzed the countries’ weekly by income
This report’s analysis is based on the weekly report consolidated that feeds the COVID-19 vaccination in the Americas dashboard. For the purpose of this analysis, we are using the data frame that contains aggregated completed schedule vaccination per country week.
#Doses historical from the DB
db <- read.csv("../exports/doses_historical.csv")
db_income <- db %>%
mutate(income_group = case_when(ISO_COUNTRY_ID %in% c("ABW", "ATG", "BMU", "BHS", "BRB", "CAN", "CHL", "CUW", "CYM", "KNA", "PRI", "SXM", "TCA", "TTO", "URY", "USA", "VGB")~ "HIGH INCOME",
ISO_COUNTRY_ID %in% c("ARG", "BRA", "COL", "CRI", "CUB", "DMA", "DOM", "ECU", "GRD", "GTM", "GUY", "JAM", "LCA", "MEX", "PAN", "PER", "PRY", "SUR", "VCT")~ "UPPER MIDDLE INCOME",
ISO_COUNTRY_ID %in% c("BLZ", "BOL", "HTI", "HND", "NIC", "SLV")~"LOWER MIDDLE INCOME",
ISO_COUNTRY_ID %in% c("AIA", "BON", "GLP", "GUF", "MSR", "MTQ", "SAB", "SEU", "VEN") ~ "NOT REGISTERED/UNCLASSIFIED")) #%>%
#filter(Region == "Non-Latin Caribbean")
doses_income_country <- db_income %>%
group_by(CountryName,income_group, rolling_week, Year, Week) %>%
summarise(at_least_1d = round(sum(vaccinated_1st_dose+single_dose, na.rm = T),1), complete_schedule = round(sum(complete_schedule, na.rm = T),1), additional_dose = round(sum(sum(booster_dose, na.rm = T), sum(fourth_doses, na.rm = T)),1))## `summarise()` has grouped output by 'CountryName', 'income_group',
## 'rolling_week', 'Year'. You can override using the `.groups` argument.
doses_income <- db_income %>%
group_by(income_group, rolling_week, Year,Week) %>%
summarise(at_least_1d = round(sum(vaccinated_1st_dose+single_dose, na.rm = T),1), complete_schedule = round(sum(complete_schedule, na.rm = T),1), additional_dose = round(sum(sum(booster_dose, na.rm = T),sum(fourth_doses, na.rm = T)),1)) ## `summarise()` has grouped output by 'income_group', 'rolling_week', 'Year'. You
## can override using the `.groups` argument.
fig <- plot_ly(doses_income %>% filter(income_group == "HIGH INCOME"), x = ~rolling_week, y = ~at_least_1d, type = 'bar', name = 'At least 1 dose',
marker = list(color = '#42aaff'
))
fig <- fig %>% add_trace(x = ~rolling_week, y = ~complete_schedule, type = 'bar',
name = 'Complete vaccination schedule',
marker = list(color = '#fc7f03')) %>%
add_trace(x = ~rolling_week, y = ~additional_dose, type = 'bar',
name = 'Additional doses',
marker = list(color = '#319165')) %>%
config(modeBarButtonsToRemove = c("zoom2d",
"pan2d",
"zoomIn2d",
"zoomOut2d",
"select2d",
"lasso2d",
"hoverCompareCartesian",
"toggleSpikelines"),
displaylogo = FALSE,
toImageButtonOptions = list(
format = "png",
filename = "High-income countries.png",
width = 1200,
height = 600
))%>%
layout(
legend = list(orientation = 'h',x = 0.3, y = 1.02),
barmode = 'stack',
title = "Upper Middle-income countries n=(19)",
xaxis = list(tickangle = 90,tickvals = min(doses_income$rolling_week):max(doses_income$rolling_week), ticktext = paste0("W", min(doses_income$rolling_week):max(doses_income$rolling_week))),
yaxis = list(title="Vaccine doses")
)
figfig <- plot_ly(doses_income %>% filter(income_group == "UPPER MIDDLE INCOME"), x = ~rolling_week, y = ~at_least_1d, type = 'bar', name = 'At least 1 dose',
marker = list(color = '#42aaff'
))
fig <- fig %>% add_trace(x = ~rolling_week, y = ~complete_schedule, type = 'bar',
name = 'Complete vaccination schedule',
marker = list(color = '#fc7f03')) %>%
add_trace(x = ~rolling_week, y = ~additional_dose, type = 'bar',
name = 'Additional doses',
marker = list(color = '#319165')) %>%
config(modeBarButtonsToRemove = c("zoom2d",
"pan2d",
"zoomIn2d",
"zoomOut2d",
"select2d",
"lasso2d",
"hoverCompareCartesian",
"toggleSpikelines"),
displaylogo = FALSE,
toImageButtonOptions = list(
format = "png",
filename = "Upper Middle-income countries.png",
width = 1200,
height = 600
))%>%
layout(
legend = list(orientation = 'h',x = 0.3, y = 1.02),
barmode = 'stack',
title = "High-income Countries n=(17)",
xaxis = list(tickangle = 90,tickvals = min(doses_income$rolling_week):max(doses_income$rolling_week), ticktext = paste0("W", min(doses_income$rolling_week):max(doses_income$rolling_week))),
yaxis = list(title="Vaccine doses")
)
figfig <- plot_ly(doses_income %>% filter(income_group == "LOWER MIDDLE INCOME"), x = ~rolling_week, y = ~at_least_1d, type = 'bar', name = 'At least 1 dose',
marker = list(color = '#42aaff'
))
fig <- fig %>% add_trace(x = ~rolling_week, y = ~complete_schedule, type = 'bar',
name = 'Complete vaccination schedule',
marker = list(color = '#fc7f03')) %>%
add_trace(x = ~rolling_week, y = ~additional_dose, type = 'bar',
name = 'Additional doses',
marker = list(color = '#319165')) %>%
config(modeBarButtonsToRemove = c("zoom2d",
"pan2d",
"zoomIn2d",
"zoomOut2d",
"select2d",
"lasso2d",
"hoverCompareCartesian",
"toggleSpikelines"),
displaylogo = FALSE,
toImageButtonOptions = list(
format = "png",
filename = "Lower Middle-income countries.png",
width = 1200,
height = 600
))%>%
layout(
legend = list(orientation = 'h',x = 0.3, y = 1.02),
barmode = 'stack',
title = "Lower Middle-income countries n=(6)",
xaxis = list(tickangle = 90,tickvals = min(doses_income$rolling_week):max(doses_income$rolling_week), ticktext = paste0("W", min(doses_income$rolling_week):max(doses_income$rolling_week))),
yaxis = list(title="Vaccine doses")
)
fig#doses_income_uptake <- doses_income %>%
# group_by(income_group) %>%
#mutate(at_least_1d = abs(at_least_1d - lag(at_least_1d)),
# complete_schedule = abs(complete_schedule - lag(complete_schedule)),
# additional_dose = abs(additional_dose - lag(additional_dose)))
#doses_income_uptake_country <- doses_income_country %>%
# group_by(CountryName, income_group) %>%
# mutate(at_least_1d = at_least_1d - lag(at_least_1d),
# complete_schedule = complete_schedule - lag(complete_schedule),
# additional_dose = additional_dose - lag(additional_dose))%>%
# mutate(at_least_1d = ifelse(at_least_1d < 0, 0, at_least_1d)) %>%
# mutate(complete_schedule = ifelse(complete_schedule < 0, 0, complete_schedule)) %>%
# mutate(additional_dose = ifelse(additional_dose < 0, 0, additional_dose)) %>%
# ungroup() %>%
# group_by(rolling_week, income_group) %>%
# summarise(at_least_1d=sum(at_least_1d, na.rm = T), complete_schedule=sum(complete_schedule, na.rm = T), additional_dose=sum(additional_dose, na.rm = T))
doses_income_uptake_country <- doses_income_country %>%
group_by(CountryName, income_group) %>%
mutate(at_least_1d = at_least_1d - lag(at_least_1d),
complete_schedule = complete_schedule - lag(complete_schedule),
additional_dose = additional_dose - lag(additional_dose))%>%
mutate(at_least_1d = ifelse(at_least_1d < 0, abs(at_least_1d), at_least_1d)) %>%
mutate(complete_schedule = ifelse(complete_schedule < 0, abs(complete_schedule), complete_schedule)) %>%
mutate(additional_dose = ifelse(additional_dose < 0,abs(additional_dose), additional_dose))
doses_income_uptake_country2 <- doses_income_uptake_country %>%
ungroup() %>%
group_by(rolling_week, income_group) %>%
summarise(at_least_1d=sum(at_least_1d, na.rm = T), complete_schedule=sum(complete_schedule, na.rm = T), additional_dose=sum(additional_dose, na.rm = T))## `summarise()` has grouped output by 'rolling_week'. You can override using the
## `.groups` argument.
doses_income_uptake <- doses_income_uptake_country2fig <- plot_ly(doses_income_uptake %>% filter(income_group == "HIGH INCOME"), x = ~rolling_week, y = ~at_least_1d, type = 'bar', name = 'At least 1 dose',
marker = list(color = '#42aaff'
))
fig <- fig %>% add_trace(x = ~rolling_week, y = ~complete_schedule, type = 'bar',
name = 'Complete vaccination schedule',
marker = list(color = '#fc7f03')) %>%
add_trace(x = ~rolling_week, y = ~additional_dose, type = 'bar',
name = 'Additional doses',
marker = list(color = '#319165')) %>%
config(modeBarButtonsToRemove = c("zoom2d",
"pan2d",
"zoomIn2d",
"zoomOut2d",
"select2d",
"lasso2d",
"hoverCompareCartesian",
"toggleSpikelines"),
displaylogo = FALSE,
toImageButtonOptions = list(
format = "png",
filename = "Uptake High-income countries.png",
width = 1200,
height = 600
))%>%
layout(
legend = list(orientation = 'h',x = 0.3, y = 1.02),
barmode = 'stack',
title = "High-income Countries n=(17)",
xaxis = list(tickangle = 90,tickvals = min(doses_income$rolling_week):max(doses_income$rolling_week), ticktext = paste0("W", min(doses_income$rolling_week):max(doses_income$rolling_week))),
yaxis = list(title="Vaccine doses")
)
figfig <- plot_ly(doses_income_uptake %>% filter(income_group == "UPPER MIDDLE INCOME"), x = ~rolling_week, y = ~at_least_1d, type = 'bar', name = 'At least 1 dose',
marker = list(color = '#42aaff'
))
fig <- fig %>% add_trace(x = ~rolling_week, y = ~complete_schedule, type = 'bar',
name = 'Complete vaccination schedule',
marker = list(color = '#fc7f03')) %>%
add_trace(x = ~rolling_week, y = ~additional_dose, type = 'bar',
name = 'Additional doses',
marker = list(color = '#319165')) %>%
config(modeBarButtonsToRemove = c("zoom2d",
"pan2d",
"zoomIn2d",
"zoomOut2d",
"select2d",
"lasso2d",
"hoverCompareCartesian",
"toggleSpikelines"),
displaylogo = FALSE,
toImageButtonOptions = list(
format = "png",
filename = "Uptake Upper Middle-income countries.png",
width = 1200,
height = 600
))%>%
layout(
legend = list(orientation = 'h',x = 0.3, y = 1.02),
barmode = 'stack',
title = "Upper Middle-income countries n=(7)",
xaxis = list(tickangle = 90,tickvals = min(doses_income$rolling_week):max(doses_income$rolling_week), ticktext = paste0("W", min(doses_income$rolling_week):max(doses_income$rolling_week))),
yaxis = list(title="Vaccine doses")
)
figfig <- plot_ly(doses_income_uptake %>% filter(income_group == "LOWER MIDDLE INCOME"), x = ~rolling_week, y = ~at_least_1d, type = 'bar', name = 'At least 1 dose',
marker = list(color = '#42aaff'
))
fig <- fig %>% add_trace(x = ~rolling_week, y = ~complete_schedule, type = 'bar',
name = 'Complete vaccination schedule',
marker = list(color = '#fc7f03')) %>%
add_trace(x = ~rolling_week, y = ~additional_dose, type = 'bar',
name = 'Additional doses',
marker = list(color = '#319165')) %>%
config(modeBarButtonsToRemove = c("zoom2d",
"pan2d",
"zoomIn2d",
"zoomOut2d",
"select2d",
"lasso2d",
"hoverCompareCartesian",
"toggleSpikelines"),
displaylogo = FALSE,
toImageButtonOptions = list(
format = "png",
filename = "Uptake Lower Middle-income countries.png",
width = 1200,
height = 600
))%>%
layout(
legend = list(orientation = 'h',x = 0.3, y = 1.02),
barmode = 'stack',
title = "Lower Middle-income countries n=(6)",
xaxis = list(tickangle = 90,tickvals = min(doses_income$rolling_week):max(doses_income$rolling_week), ticktext = paste0("W", min(doses_income$rolling_week):max(doses_income$rolling_week))),
yaxis = list(title="Vaccine doses")
)
fig